Decorrelation-Based Feature Discovery: Wisconsin

1 Effect of UPSTM-Based Decorrelation on Feature Discovery

1.0.1 Loading the libraries

library("FRESA.CAD")
library(readxl)
library(igraph)
library(umap)
library(tsne)
library(entropy)
library(TH.data)
library(psych)
library(whitening)
library("vioplot")
library("rpart")
library(mlbench)

op <- par(no.readonly = TRUE)
pander::panderOptions('digits', 3)
pander::panderOptions('table.split.table', 400)
pander::panderOptions('keep.trailing.zeros',TRUE)

1.1 Material and Methods

Source W. Nick Street, Olvi L. Mangasarian and William H. Wolberg (1995). An inductive learning approach to prognostic prediction. In A. Prieditis and S. Russell, editors, Proceedings of the Twelfth International Conference on Machine Learning, pages 522–530, San Francisco, Morgan Kaufmann.

Peter Buehlmann and Torsten Hothorn (2007), Boosting algorithms: regularization, prediction and model fitting. Statistical Science, 22(4), 477–505.

1.2 The Data

wpbc {TH.data}

data("wpbc", package = "TH.data")
table(wpbc[,"status"])
#> 
#>   N   R 
#> 151  47
sum(1*(wpbc[,"status"]=="R" &  wpbc$time <= 24))
#> [1] 29
wpbc <- subset(wpbc,time > 36 | status=="R" )
summary(wpbc$time)
#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#>    1.00   36.75   60.50   58.79   78.75  125.00
wpbc[,"status"] <- 1*(wpbc[,"status"]=="R")
wpbc <- wpbc[complete.cases(wpbc),]
pander::pander(table(wpbc[,"status"]))

0	1
91	46

wpbc$time <- NULL

1.2.0.1 Standarize the names for the reporting

studyName <- "Wisconsin"
dataframe <- wpbc
outcome <- "status"
thro <- 0.4
TopVariables <- 10
cexheat = 0.25

1.3 Generaring the report

1.3.1 Libraries

Some libraries

library(psych)
library(whitening)
library("vioplot")
library("rpart")

1.3.2 Data specs

pander::pander(c(rows=nrow(dataframe),col=ncol(dataframe)-1))

rows	col
137	32

pander::pander(table(dataframe[,outcome]))

0	1
91	46

varlist <- colnames(dataframe)
varlist <- varlist[varlist != outcome]

largeSet <- length(varlist) > 1500 

1.3.3 Scaling the data

Scaling and removing near zero variance columns and highly co-linear(r>0.99999) columns

  ### Some global cleaning
  sdiszero <- apply(dataframe,2,sd) > 1.0e-16
  dataframe <- dataframe[,sdiszero]

  varlist <- colnames(dataframe)[colnames(dataframe) != outcome]
  tokeep <- c(as.character(correlated_Remove(dataframe,varlist,thr=0.99999)),outcome)
  dataframe <- dataframe[,tokeep]

  varlist <- colnames(dataframe)
  varlist <- varlist[varlist != outcome]
  
  iscontinous <- sapply(apply(dataframe,2,unique),length) >= 5 ## Only variables with enough samples



dataframeScaled <- FRESAScale(dataframe,method="OrderLogit")$scaledData

1.4 The heatmap of the data

numsub <- nrow(dataframe)
if (numsub > 1000) numsub <- 1000


if (!largeSet)
{

  hm <- heatMaps(data=dataframeScaled[1:numsub,],
                 Outcome=outcome,
                 Scale=TRUE,
                 hCluster = "row",
                 xlab="Feature",
                 ylab="Sample",
                 srtCol=45,
                 srtRow=45,
                 cexCol=cexheat,
                 cexRow=cexheat
                 )
  par(op)
}

1.4.0.1 Correlation Matrix of the Data

The heat map of the data

if (!largeSet)
{

  par(cex=0.6,cex.main=0.85,cex.axis=0.7)
  #cormat <- Rfast::cora(as.matrix(dataframe[,varlist]),large=TRUE)
  cormat <- cor(dataframe[,varlist],method="pearson")
  cormat[is.na(cormat)] <- 0
  gplots::heatmap.2(abs(cormat),
                    trace = "none",
  #                  scale = "row",
                    mar = c(5,5),
                    col=rev(heat.colors(5)),
                    main = "Original Correlation",
                    cexRow = cexheat,
                    cexCol = cexheat,
                     srtCol=45,
                     srtRow=45,
                    key.title=NA,
                    key.xlab="|Pearson Correlation|",
                    xlab="Feature", ylab="Feature")
  diag(cormat) <- 0
  print(max(abs(cormat)))
}

[1] 0.9961379

1.5 The decorrelation

DEdataframe <- IDeA(dataframe,verbose=TRUE,thr=thro)
#> 
#>  mean_perimeter mean_texture tsize 
#>      mean_radius     mean_texture   mean_perimeter        mean_area 
#>          0.96875          0.50000          1.00000          0.93750 
#>  mean_smoothness mean_compactness 
#>          0.34375          0.40625 
#> 
#>  Included: 32 , Uni p: 0.0046875 , Base Size: 3 , Rcrit: 0.2212374 
#> 
#> 
 1 <R=0.996,thr=0.950>, Top: 3< 2 >[Fa= 3 ]( 3 , 6 , 0 ),<|><>Tot Used: 9 , Added: 6 , Zero Std: 0 , Max Cor: 0.922
#> 
 2 <R=0.922,thr=0.900>, Top: 1< 1 >[Fa= 3 ]( 1 , 1 , 3 ),<|><>Tot Used: 9 , Added: 1 , Zero Std: 0 , Max Cor: 0.891
#> 
 3 <R=0.891,thr=0.800>, Top: 6< 1 >[Fa= 9 ]( 6 , 6 , 3 ),<|><>Tot Used: 18 , Added: 6 , Zero Std: 0 , Max Cor: 0.842
#> 
 4 <R=0.842,thr=0.800>, Top: 1< 1 >[Fa= 10 ]( 1 , 1 , 9 ),<|><>Tot Used: 20 , Added: 1 , Zero Std: 0 , Max Cor: 0.789
#> 
 5 <R=0.789,thr=0.700>, Top: 6< 1 >[Fa= 12 ]( 6 , 6 , 10 ),<|><>Tot Used: 25 , Added: 6 , Zero Std: 0 , Max Cor: 0.743
#> 
 6 <R=0.743,thr=0.700>, Top: 2< 1 >[Fa= 13 ]( 2 , 2 , 12 ),<|><>Tot Used: 27 , Added: 2 , Zero Std: 0 , Max Cor: 0.698
#> 
 7 <R=0.698,thr=0.600>, Top: 3< 2 >[Fa= 13 ]( 3 , 4 , 13 ),<|><>Tot Used: 27 , Added: 4 , Zero Std: 0 , Max Cor: 0.768
#> 
 8 <R=0.768,thr=0.700>, Top: 2< 1 >[Fa= 13 ]( 2 , 2 , 13 ),<|><>Tot Used: 27 , Added: 2 , Zero Std: 0 , Max Cor: 0.600
#> 
 9 <R=0.600,thr=0.600>, Top: 1< 1 >[Fa= 13 ]( 1 , 1 , 13 ),<|><>Tot Used: 27 , Added: 1 , Zero Std: 0 , Max Cor: 0.749
#> 
 10 <R=0.749,thr=0.700>, Top: 1< 1 >[Fa= 13 ]( 1 , 1 , 13 ),<|><>Tot Used: 27 , Added: 1 , Zero Std: 0 , Max Cor: 0.600
#> 
 11 <R=0.600,thr=0.500>, Top: 7< 1 >[Fa= 15 ]( 7 , 8 , 13 ),<|><>Tot Used: 28 , Added: 8 , Zero Std: 0 , Max Cor: 0.685
#> 
 12 <R=0.685,thr=0.600>, Top: 2< 1 >[Fa= 15 ]( 2 , 2 , 15 ),<|><>Tot Used: 28 , Added: 2 , Zero Std: 0 , Max Cor: 0.607
#> 
 13 <R=0.607,thr=0.600>, Top: 1< 1 >[Fa= 15 ]( 1 , 1 , 15 ),<|><>Tot Used: 28 , Added: 1 , Zero Std: 0 , Max Cor: 0.580
#> 
 14 <R=0.580,thr=0.500>, Top: 1< 1 >[Fa= 16 ]( 1 , 1 , 15 ),<|><>Tot Used: 28 , Added: 1 , Zero Std: 0 , Max Cor: 0.500
#> 
 15 <R=0.500,thr=0.400>, Top: 9< 1 >[Fa= 18 ]( 8 , 11 , 16 ),<|><>Tot Used: 32 , Added: 11 , Zero Std: 0 , Max Cor: 0.573
#> 
 16 <R=0.573,thr=0.500>, Top: 2< 1 >[Fa= 18 ]( 2 , 2 , 18 ),<|><>Tot Used: 32 , Added: 2 , Zero Std: 0 , Max Cor: 0.548
#> 
 17 <R=0.548,thr=0.500>, Top: 1< 1 >[Fa= 18 ]( 1 , 1 , 18 ),<|><>Tot Used: 32 , Added: 1 , Zero Std: 0 , Max Cor: 0.630
#> 
 18 <R=0.630,thr=0.600>, Top: 1< 1 >[Fa= 19 ]( 1 , 1 , 18 ),<|><>Tot Used: 32 , Added: 1 , Zero Std: 0 , Max Cor: 0.493
#> 
 19 <R=0.493,thr=0.400>, Top: 5< 1 >[Fa= 20 ]( 5 , 6 , 19 ),<|><>Tot Used: 32 , Added: 6 , Zero Std: 0 , Max Cor: 0.512
#> 
 20 <R=0.512,thr=0.500>, Top: 1< 1 >[Fa= 21 ]( 1 , 1 , 20 ),<|><>Tot Used: 32 , Added: 1 , Zero Std: 0 , Max Cor: 0.469
#> 
 21 <R=0.469,thr=0.400>, Top: 7< 1 >[Fa= 22 ]( 4 , 4 , 21 ),<|><>Tot Used: 32 , Added: 4 , Zero Std: 0 , Max Cor: 0.501
#> 
 22 <R=0.501,thr=0.500>, Top: 1< 1 >[Fa= 22 ]( 1 , 1 , 22 ),<|><>Tot Used: 32 , Added: 1 , Zero Std: 0 , Max Cor: 0.488
#> 
 23 <R=0.488,thr=0.400>, Top: 2< 1 >[Fa= 22 ]( 2 , 2 , 22 ),<|><>Tot Used: 32 , Added: 2 , Zero Std: 0 , Max Cor: 0.398
#> 
 24 <R=0.398,thr=0.400>
#> 
 [ 24 ], 0.3981401 Decor Dimension: 32 Nused: 32 . Cor to Base: 24 , ABase: 32 , Outcome Base: 0 
#> 
varlistc <- colnames(DEdataframe)[colnames(DEdataframe) != outcome]

pander::pander(sum(apply(dataframe[,varlist],2,var)))

515156

pander::pander(sum(apply(DEdataframe[,varlistc],2,var)))

6371

pander::pander(entropy(discretize(unlist(dataframe[,varlist]), 256)))

1.39

pander::pander(entropy(discretize(unlist(DEdataframe[,varlistc]), 256)))

1.3

varratio <- attr(DEdataframe,"VarRatio")

pander::pander(tail(varratio))

La_SE_perimeter	La_SE_area	La_mean_area	La_worst_radius	La_worst_area	La_mean_radius
0.0226	0.0224	0.0151	0.0124	0.00986	0.00771

1.5.1 The decorrelation matrix

if (!largeSet)
{

  par(cex=0.6,cex.main=0.85,cex.axis=0.7)
  
  UPLTM <- attr(DEdataframe,"UPLTM")
  
  gplots::heatmap.2(1.0*(abs(UPLTM)>0),
                    trace = "none",
                    mar = c(5,5),
                    col=rev(heat.colors(5)),
                    main = "Decorrelation matrix",
                    cexRow = cexheat,
                    cexCol = cexheat,
                   srtCol=45,
                   srtRow=45,
                    key.title=NA,
                    key.xlab="|Beta|>0",
                    xlab="Output Feature", ylab="Input Feature")
  
  par(op)
  
  
  
}

1.5.2 Formulas Network

Displaying the features associations

par(op)
clustable <- c("To many variables")


  transform <- attr(DEdataframe,"UPLTM") != 0
  tnames <- colnames(transform)
  colnames(transform) <- str_remove_all(colnames(transform),"La_")
  transform <- abs(transform*cor(dataframe[,rownames(transform)])) # The weights are proportional to the observed correlation
  
  
  fscore <- attr(DEdataframe,"fscore")
  VertexSize <- fscore # The size depends on the variable independence relevance (fscore)
  names(VertexSize) <- str_remove_all(names(VertexSize),"La_")
  VertexSize <- 10*(VertexSize-min(VertexSize))/(max(VertexSize)-min(VertexSize)) # Normalization

  VertexSize <- VertexSize[rownames(transform)]
  rsum <- apply(1*(transform !=0),1,sum) + 0.01*VertexSize + 0.001*varratio[tnames]
  csum <- apply(1*(transform !=0),2,sum) + 0.01*VertexSize + 0.001*varratio[tnames]
  
  ntop <- min(10,length(rsum))


  topfeatures <- unique(c(names(rsum[order(-rsum)])[1:ntop],names(csum[order(-csum)])[1:ntop]))
  rtrans <- transform[topfeatures,]
  csum <- (apply(1*(rtrans !=0),2,sum) > 1*(colnames(rtrans) %in% topfeatures))
  rtrans <- rtrans[,csum]
  topfeatures <- unique(c(topfeatures,colnames(rtrans)))
  print(ncol(transform))

[1] 32

  transform <- transform[topfeatures,topfeatures]
  print(ncol(transform))

[1] 28

  if (ncol(transform)>100)
  {
    csum <- apply(1*(transform !=0),1,sum)
    csum <- csum[csum > 1]
    csum <- csum[order(-csum)]
    tpsum <- min(20,length(csum))
    trsum <- rownames(transform)[rownames(transform) %in% names(csum[1:tpsum])]
    rtrans <- transform[trsum,]
    topfeatures <- unique(c(rownames(rtrans),colnames(rtrans)))
    transform <- transform[topfeatures,topfeatures]
    if (nrow(transform) > 100)
    {
      csum <- apply(1*(rtrans != 0 ),2,sum)
      csum <- csum[csum > 1]
      csum <- csum[order(-csum)]
      tpsum <- min(80,length(csum))
      csum <- rownames(transform)[rownames(transform) %in% names(csum[1:tpsum])]
      csum <- unique(c(trsum,csum))
      transform <- transform[csum,csum]
    }
    print(ncol(transform))
  }

    if (ncol(transform) < 150)
    {

      gplots::heatmap.2(transform,
                        trace = "none",
                        mar = c(5,5),
                        col=rev(heat.colors(5)),
                        main = "Red Decorrelation matrix",
                        cexRow = cexheat,
                        cexCol = cexheat,
                       srtCol=45,
                       srtRow=45,
                        key.title=NA,
                        key.xlab="|Beta|>0",
                        xlab="Output Feature", ylab="Input Feature")
  
      par(op)
      VertexSize <- VertexSize[colnames(transform)]
      gr <- graph_from_adjacency_matrix(transform,mode = "directed",diag = FALSE,weighted=TRUE)
      gr$layout <- layout_with_fr
      
      fc <- cluster_optimal(gr)
      plot(fc, gr,
           edge.width = 2*E(gr)$weight,
           vertex.size=VertexSize,
           edge.arrow.size=0.5,
           edge.arrow.width=0.5,
           vertex.label.cex=(0.15+0.05*VertexSize),
           vertex.label.dist=0.5 + 0.05*VertexSize,
           main="Top Feature Association")
      
      varratios <- varratio
      fscores <- fscore
      names(varratios) <- str_remove_all(names(varratios),"La_")
      names(fscores) <- str_remove_all(names(fscores),"La_")

      dc <- getLatentCoefficients(DEdataframe)
      theCharformulas <- attr(dc,"LatentCharFormulas")

      
      clustable <- as.data.frame(cbind(Variable=fc$names,
                                       Formula=as.character(theCharformulas[paste("La_",fc$names,sep="")]),
                                       Class=fc$membership,
                                       ResidualVariance=round(varratios[fc$names],3),
                                       Fscore=round(fscores[fc$names],3)
                                       )
                                 )
      rownames(clustable) <- str_replace_all(rownames(clustable),"__","_")
      clustable$Variable <- NULL
      clustable$Class <- as.integer(clustable$Class)
      clustable$ResidualVariance <- as.numeric(clustable$ResidualVariance)
      clustable$Fscore <- as.numeric(clustable$Fscore)
      clustable <- clustable[order(-clustable$Fscore),]
      clustable <- clustable[order(clustable$Class),]
      clustable <- clustable[clustable$Fscore >= -1,]
      topv <- min(50,nrow(clustable))
      clustable <- clustable[1:topv,]
    }

pander::pander(clustable)

	Formula	Class	ResidualVariance	Fscore
mean_perimeter	NA	1	1.000	9
mean_radius	+ mean_radius - (0.149)mean_perimeter	1	0.008	9
SE_radius	+ (4.16e-03)mean_perimeter + SE_radius - (9.27e-03)worst_perimeter	1	0.501	3
worst_perimeter	- (1.298)mean_perimeter + worst_perimeter	1	0.151	2
mean_area	- (83.732)mean_radius - (4.090)mean_perimeter + mean_area	1	0.015	0
worst_radius	- (1.834)mean_radius + (0.273)mean_perimeter + worst_radius - (0.147)worst_perimeter	1	0.012	0
worst_compactness	+ (0.405)mean_radius - (0.060)mean_perimeter + worst_compactness	2	0.533	5
mean_fractaldim	+ (0.019)mean_radius - (2.69e-03)mean_perimeter + mean_fractaldim	2	0.328	5
mean_concavepoints	+ (0.029)mean_radius - (5.65e-03)mean_perimeter + mean_concavepoints - (1.846)mean_fractaldim	2	0.161	0
mean_symmetry	- (5.03e-03)mean_radius + (3.22e-04)mean_perimeter + mean_symmetry - (2.774)mean_fractaldim	2	0.603	0
mean_smoothness	- (0.012)mean_radius + (2.32e-03)mean_perimeter + mean_smoothness - (0.411)mean_concavepoints - (0.521)mean_fractaldim	2	0.201	-1
worst_symmetry	- (0.094)mean_radius + (0.014)mean_perimeter - (2.064)mean_symmetry - (0.232)worst_compactness + worst_symmetry	2	0.281	-1
worst_fractaldim	- (0.029)mean_radius + (4.31e-03)mean_perimeter - (2.460)mean_fractaldim - (0.071)worst_compactness + worst_fractaldim	2	0.131	-1
SE_fractaldim	+ (4.86e-04)mean_radius - (1.01e-04)mean_perimeter - (0.184)mean_fractaldim + SE_fractaldim	3	0.532	3
SE_compactness	+ SE_compactness - (7.818)SE_fractaldim	3	0.272	2
worst_concavity	- (0.830)worst_compactness + worst_concavity	3	0.292	1

par(op)

1.6 The heatmap of the decorrelated data

if (!largeSet)
{

  hm <- heatMaps(data=DEdataframe[1:numsub,],
                 Outcome=outcome,
                 Scale=TRUE,
                 hCluster = "row",
                 cexRow = cexheat,
                 cexCol = cexheat,
                 srtCol=45,
                 srtRow=45,
                 xlab="Feature",
                 ylab="Sample")
  par(op)
}

1.7 The correlation matrix after decorrelation

if (!largeSet)
{

  cormat <- cor(DEdataframe[,varlistc],method="pearson")
  cormat[is.na(cormat)] <- 0
  
  gplots::heatmap.2(abs(cormat),
                    trace = "none",
                    mar = c(5,5),
                    col=rev(heat.colors(5)),
                    main = "Correlation after ILAA",
                    cexRow = cexheat,
                    cexCol = cexheat,
                     srtCol=45,
                     srtRow=45,
                    key.title=NA,
                    key.xlab="|Pearson Correlation|",
                    xlab="Feature", ylab="Feature")
  
  par(op)
  diag(cormat) <- 0
  print(max(abs(cormat)))
}

[1] 0.3981401

1.8 U-MAP Visualization of features

1.8.1 The UMAP on Raw Data

  classes <- unique(dataframe[1:numsub,outcome])
  raincolors <- rainbow(length(classes))
  names(raincolors) <- classes
  topvars <- univariate_BinEnsemble(dataframe,outcome)
  lso <- LASSO_MIN(formula(paste(outcome,"~.")),dataframe,family="binomial")
  topvars <- unique(c(names(topvars),lso$selectedfeatures))
  pander::pander(head(topvars))

mean_radius, worst_radius, pnodes, tsize, SE_perimeter and SE_radius

#  names(topvars)
#if (nrow(dataframe) < 1000)
#{
  datasetframe.umap = umap(scale(dataframe[1:numsub,topvars]),n_components=2)
#  datasetframe.umap = umap(dataframe[1:numsub,varlist],n_components=2)
  plot(datasetframe.umap$layout,xlab="U1",ylab="U2",main="UMAP: Original",t='n')
  text(datasetframe.umap$layout,labels=dataframe[1:numsub,outcome],col=raincolors[dataframe[1:numsub,outcome]+1])

#}

1.8.2 The decorralted UMAP

  varlistcV <- names(varratio[varratio >= 0.01])
  topvars <- univariate_BinEnsemble(DEdataframe[,varlistcV],outcome)
  lso <- LASSO_MIN(formula(paste(outcome,"~.")),DEdataframe[,varlistcV],family="binomial")
  topvars <- unique(c(names(topvars),lso$selectedfeatures))
  pander::pander(head(topvars))

tsize, mean_perimeter, La_worst_fractaldim, La_SE_symmetry, La_mean_smoothness and La_mean_fractaldim

  varlistcV <- varlistcV[varlistcV != outcome]
  
#  DEdataframe[,outcome] <- as.numeric(DEdataframe[,outcome])
#if (nrow(dataframe) < 1000)
#{
  datasetframe.umap = umap(scale(DEdataframe[1:numsub,topvars]),n_components=2)
#  datasetframe.umap = umap(DEdataframe[1:numsub,varlistcV],n_components=2)
  plot(datasetframe.umap$layout,xlab="U1",ylab="U2",main="UMAP: After ILAA",t='n')
  text(datasetframe.umap$layout,labels=DEdataframe[1:numsub,outcome],col=raincolors[DEdataframe[1:numsub,outcome]+1])

#}

1.9 Univariate Analysis

1.9.1 Univariate

univarRAW <- uniRankVar(varlist,
               paste(outcome,"~1"),
               outcome,
               dataframe,
               rankingTest="AUC")



univarDe <- uniRankVar(varlistc,
               paste(outcome,"~1"),
               outcome,
               DEdataframe,
               rankingTest="AUC",
               )

1.9.2 Final Table

univariate_columns <- c("caseMean","caseStd","controlMean","controlStd","controlKSP","ROCAUC")

##top variables
topvar <- c(1:length(varlist)) <= TopVariables
tableRaw <- univarRAW$orderframe[topvar,univariate_columns]
pander::pander(tableRaw)

	caseMean	caseStd	controlMean	controlStd	controlKSP	ROCAUC
tsize	3.47	2.03	2.64	1.86	1.11e-03	0.666
pnodes	4.87	6.02	2.63	5.21	6.25e-09	0.650
worst_radius	22.67	4.70	20.35	4.08	3.68e-01	0.647
worst_perimeter	151.33	32.42	135.34	26.85	5.71e-01	0.645
mean_area	1081.98	397.26	888.40	310.85	1.26e-01	0.645
worst_area	1635.77	703.15	1317.95	550.94	2.72e-01	0.643
mean_perimeter	121.10	22.91	110.02	19.19	4.72e-01	0.641
mean_radius	18.33	3.37	16.70	2.91	3.12e-01	0.639
SE_perimeter	4.73	2.21	3.81	1.80	6.37e-02	0.634
SE_area	81.97	53.36	61.22	37.72	6.46e-02	0.632

topLAvar <- univarDe$orderframe$Name[str_detect(univarDe$orderframe$Name,"La_")]
topLAvar <- unique(c(univarDe$orderframe$Name[topvar],topLAvar[1:as.integer(TopVariables/2)]))
finalTable <- univarDe$orderframe[topLAvar,univariate_columns]


pander::pander(finalTable)

	caseMean	caseStd	controlMean	controlStd	controlKSP	ROCAUC
tsize	3.47174	2.02985	2.63846	1.85507	0.00111	0.666
La_worst_area	409.10338	59.42237	440.08923	60.65702	0.52089	0.653
La_SE_symmetry	-0.00356	0.00448	-0.00579	0.00572	0.23435	0.645
mean_perimeter	121.09522	22.91019	110.02231	19.18940	0.47168	0.641
La_worst_fractaldim	-0.09538	0.00580	-0.09896	0.00862	0.93594	0.639
La_mean_smoothness	0.09341	0.00508	0.09102	0.00555	0.90681	0.626
La_mean_fractaldim	0.08522	0.00324	0.08699	0.00471	0.35987	0.600
La_worst_perimeter	-5.80502	11.69785	-7.42934	11.47409	0.02995	0.577
La_SE_concavity	-0.01260	0.00681	-0.01037	0.00581	0.22238	0.573
La_worst_concavity	0.14327	0.09717	0.11997	0.08164	0.81386	0.572

dc <- getLatentCoefficients(DEdataframe)
fscores <- attr(DEdataframe,"fscore")


pander::pander(c(mean=mean(sapply(dc,length)),total=length(dc),fraction=length(dc)/(ncol(dataframe)-1)))

mean	total	fraction
4.79	29	0.906

theCharformulas <- attr(dc,"LatentCharFormulas")

topvar <- rownames(tableRaw)
finalTable <- rbind(finalTable,tableRaw[topvar[!(topvar %in% topLAvar)],univariate_columns])


orgnamez <- rownames(finalTable)
orgnamez <- str_remove_all(orgnamez,"La_")
finalTable$RAWAUC <- univarRAW$orderframe[orgnamez,"ROCAUC"]
finalTable$DecorFormula <- theCharformulas[rownames(finalTable)]
finalTable$fscores <- fscores[rownames(finalTable)]
finalTable$varratio <- varratio[rownames(finalTable)]

Final_Columns <- c("DecorFormula","caseMean","caseStd","controlMean","controlStd","controlKSP","ROCAUC","RAWAUC","fscores","varratio")

finalTable <- finalTable[order(-finalTable$ROCAUC),]
pander::pander(finalTable[,Final_Columns])

	DecorFormula	caseMean	caseStd	controlMean	controlStd	controlKSP	ROCAUC	RAWAUC	fscores	varratio
tsize	NA	3.47e+00	2.03e+00	2.64e+00	1.86e+00	1.11e-03	0.666	0.666	1	1.00000
La_worst_area	+ (2.56e+02)mean_radius - (4.838)mean_perimeter - (2.009)mean_area - (1.39e+02)worst_radius + (0.035)worst_perimeter + worst_area	4.09e+02	5.94e+01	4.40e+02	6.07e+01	5.21e-01	0.653	0.643	-2	0.00986
pnodes	NA	4.87e+00	6.02e+00	2.63e+00	5.21e+00	6.25e-09	0.650	0.650	NA	NA
worst_radius	NA	2.27e+01	4.70e+00	2.03e+01	4.08e+00	3.68e-01	0.647	0.647	NA	NA
worst_perimeter	NA	1.51e+02	3.24e+01	1.35e+02	2.68e+01	5.71e-01	0.645	0.645	NA	NA
La_SE_symmetry	- (2.99e-03)mean_radius + (5.30e-04)mean_perimeter + (3.57e-03)mean_symmetry - (0.376)mean_fractaldim + SE_symmetry - (2.978)SE_fractaldim - (3.80e-03)worst_compactness - (0.099)worst_symmetry + (0.375)worst_fractaldim	-3.56e-03	4.48e-03	-5.79e-03	5.72e-03	2.34e-01	0.645	0.504	-4	0.27828
mean_area	NA	1.08e+03	3.97e+02	8.88e+02	3.11e+02	1.26e-01	0.645	0.645	NA	NA
worst_area	NA	1.64e+03	7.03e+02	1.32e+03	5.51e+02	2.72e-01	0.643	0.643	NA	NA
mean_perimeter	NA	1.21e+02	2.29e+01	1.10e+02	1.92e+01	4.72e-01	0.641	0.641	9	1.00000
La_worst_fractaldim	- (0.029)mean_radius + (4.31e-03)mean_perimeter - (2.460)mean_fractaldim - (0.071)worst_compactness + worst_fractaldim	-9.54e-02	5.80e-03	-9.90e-02	8.62e-03	9.36e-01	0.639	0.583	-1	0.13072
mean_radius	NA	1.83e+01	3.37e+00	1.67e+01	2.91e+00	3.12e-01	0.639	0.639	NA	NA
SE_perimeter	NA	4.73e+00	2.21e+00	3.81e+00	1.80e+00	6.37e-02	0.634	0.634	NA	NA
SE_area	NA	8.20e+01	5.34e+01	6.12e+01	3.77e+01	6.46e-02	0.632	0.632	NA	NA
La_mean_smoothness	- (0.012)mean_radius + (2.32e-03)mean_perimeter + mean_smoothness - (0.411)mean_concavepoints - (0.521)mean_fractaldim	9.34e-02	5.08e-03	9.10e-02	5.55e-03	9.07e-01	0.626	0.518	-1	0.20052
La_mean_fractaldim	+ (0.019)mean_radius - (2.69e-03)mean_perimeter + mean_fractaldim	8.52e-02	3.24e-03	8.70e-02	4.71e-03	3.60e-01	0.600	0.615	5	0.32801
La_worst_perimeter	- (1.298)mean_perimeter + worst_perimeter	-5.81e+00	1.17e+01	-7.43e+00	1.15e+01	2.99e-02	0.577	0.645	2	0.15076
La_SE_concavity	- (0.766)SE_compactness + SE_concavity - (1.245)SE_concavepoints + (0.455)SE_fractaldim + (0.064)worst_compactness - (0.077)worst_concavity	-1.26e-02	6.81e-03	-1.04e-02	5.81e-03	2.22e-01	0.573	0.478	-2	0.10094
La_worst_concavity	- (0.830)worst_compactness + worst_concavity	1.43e-01	9.72e-02	1.20e-01	8.16e-02	8.14e-01	0.572	0.492	1	0.29167

1.10 Comparing ILAA vs PCA vs EFA

1.10.1 PCA

featuresnames <- colnames(dataframe)[colnames(dataframe) != outcome]
pc <- prcomp(dataframe[,iscontinous],center = TRUE,scale. = TRUE,tol=0.01)   #principal components
predPCA <- predict(pc,dataframe[,iscontinous])
PCAdataframe <- as.data.frame(cbind(predPCA,dataframe[,!iscontinous]))
colnames(PCAdataframe) <- c(colnames(predPCA),colnames(dataframe)[!iscontinous]) 
#plot(PCAdataframe[,colnames(PCAdataframe)!=outcome],col=dataframe[,outcome],cex=0.65,cex.lab=0.5,cex.axis=0.75,cex.sub=0.5,cex.main=0.75)

#pander::pander(pc$rotation)


PCACor <- cor(PCAdataframe[,colnames(PCAdataframe) != outcome])


  gplots::heatmap.2(abs(PCACor),
                    trace = "none",
  #                  scale = "row",
                    mar = c(5,5),
                    col=rev(heat.colors(5)),
                    main = "PCA Correlation",
                    cexRow = 0.5,
                    cexCol = 0.5,
                     srtCol=45,
                     srtRow= -45,
                    key.title=NA,
                    key.xlab="Pearson Correlation",
                    xlab="Feature", ylab="Feature")

1.10.2 EFA

EFAdataframe <- dataframeScaled

if (length(iscontinous) < 2000)
{
  topred <- min(length(iscontinous),nrow(dataframeScaled),ncol(predPCA)-1)
  if (topred < 2) topred <- 2
  
  uls <- fa(dataframeScaled[,iscontinous],nfactors=topred,rotate="varimax",warnings=FALSE)  # EFA analysis
  predEFA <- predict(uls,dataframeScaled[,iscontinous])
  EFAdataframe <- as.data.frame(cbind(predEFA,dataframeScaled[,!iscontinous]))
  colnames(EFAdataframe) <- c(colnames(predEFA),colnames(dataframeScaled)[!iscontinous]) 


  
  EFACor <- cor(EFAdataframe[,colnames(EFAdataframe) != outcome])
  
  
    gplots::heatmap.2(abs(EFACor),
                      trace = "none",
    #                  scale = "row",
                      mar = c(5,5),
                      col=rev(heat.colors(5)),
                      main = "EFA Correlation",
                      cexRow = 0.5,
                      cexCol = 0.5,
                       srtCol=45,
                       srtRow= -45,
                      key.title=NA,
                      key.xlab="Pearson Correlation",
                      xlab="Feature", ylab="Feature")
}

1.11 Effect on CAR modeling

par(op)
par(xpd = TRUE)
dataframe[,outcome] <- factor(dataframe[,outcome])
rawmodel <- rpart(paste(outcome,"~."),dataframe,control=rpart.control(maxdepth=3))
pr <- predict(rawmodel,dataframe,type = "class")

  ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
  if (length(unique(pr))>1)
  {
    plot(rawmodel,main="Raw",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
    text(rawmodel, use.n = TRUE,cex=0.75)
    ptab <- epiR::epi.tests(table(pr==0,dataframe[,outcome]==0))
  }

pander::pander(table(dataframe[,outcome],pr))

	0	1
0	68	23
1	9	37

pander::pander(ptab$detail[c(5,3,4,6),])

	statistic	est	lower	upper
5	diag.ac	0.766	0.687	0.834
3	se	0.804	0.661	0.906
4	sp	0.747	0.645	0.833
6	diag.or	12.155	5.100	28.966

par(op)
par(xpd = TRUE)
DEdataframe[,outcome] <- factor(DEdataframe[,outcome])
IDeAmodel <- rpart(paste(outcome,"~."),DEdataframe[,c(outcome,varlistcV)],control=rpart.control(maxdepth=3))
pr <- predict(IDeAmodel,DEdataframe,type = "class")

  ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
  if (length(unique(pr))>1)
  {
    plot(IDeAmodel,main="ILAA",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
    text(IDeAmodel, use.n = TRUE,cex=0.75)
    ptab <- epiR::epi.tests(table(pr==0,DEdataframe[,outcome]==0))
  }

pander::pander(table(DEdataframe[,outcome],pr))

	0	1
0	89	2
1	33	13

pander::pander(ptab$detail[c(5,3,4,6),])

	statistic	est	lower	upper
5	diag.ac	0.745	0.663	0.815
3	se	0.283	0.160	0.435
4	sp	0.978	0.923	0.997
6	diag.or	17.530	3.753	81.883

par(op)
par(xpd = TRUE)
PCAdataframe[,outcome] <- factor(PCAdataframe[,outcome])
PCAmodel <- rpart(paste(outcome,"~."),PCAdataframe,control=rpart.control(maxdepth=3))
pr <- predict(PCAmodel,PCAdataframe,type = "class")
ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
if (length(unique(pr))>1)
{
  plot(PCAmodel,main="PCA",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
  text(PCAmodel, use.n = TRUE,cex=0.75)
  ptab <- epiR::epi.tests(table(pr==0,PCAdataframe[,outcome]==0))
}

pander::pander(table(PCAdataframe[,outcome],pr))

	0	1
0	86	5
1	27	19

pander::pander(ptab$detail[c(5,3,4,6),])

	statistic	est	lower	upper
5	diag.ac	0.766	0.687	0.834
3	se	0.413	0.270	0.568
4	sp	0.945	0.876	0.982
6	diag.or	12.104	4.128	35.493

par(op)

1.11.1 EFA

  EFAdataframe[,outcome] <- factor(EFAdataframe[,outcome])
  EFAmodel <- rpart(paste(outcome,"~."),EFAdataframe,control=rpart.control(maxdepth=3))
  pr <- predict(EFAmodel,EFAdataframe,type = "class")
  
  ptab <- list(er="Error",detail=matrix(nrow=6,ncol=1))
  if (length(unique(pr))>1)
  {
    plot(EFAmodel,main="EFA",branch=0.5,uniform = TRUE,compress = TRUE,margin=0.1)
    text(EFAmodel, use.n = TRUE,cex=0.75)
    ptab <- epiR::epi.tests(table(pr==0,EFAdataframe[,outcome]==0))
  }

  pander::pander(table(EFAdataframe[,outcome],pr))

	0	1
0	73	18
1	11	35

  pander::pander(ptab$detail[c(5,3,4,6),])

	statistic	est	lower	upper
5	diag.ac	0.788	0.710	0.853
3	se	0.761	0.612	0.874
4	sp	0.802	0.706	0.878
6	diag.or	12.904	5.507	30.236

  par(op)